(defpackage :lem/markdown-buffer
  (:use :cl :lem)
  (:export :markdown-buffer))
(in-package :lem/markdown-buffer)

(defun trim-final-newlines (point)
  (with-point ((start point :left-inserting)
               (end point :left-inserting))
    (buffer-end start)
    (buffer-end end)
    (skip-whitespace-backward start)
    (delete-between-points start end)))

(defun make-temporary-unwrap-buffer ()
  (let ((buffer (make-buffer nil :temporary t :enable-undo-p nil)))
    (setf (variable-value 'lem:line-wrap :buffer buffer) nil)
    buffer))

(defun markdown-buffer (markdown-text)
  (labels ((make-markdown-buffer (markdown-text)
             (let* ((buffer (make-temporary-unwrap-buffer))
                    (point (buffer-point buffer)))
               (setf (variable-value 'enable-syntax-highlight :buffer buffer) t)
               (erase-buffer buffer)
               (insert-string point markdown-text)
               (put-foreground buffer)
               buffer))
           (put-foreground (buffer)
             (put-text-property (buffer-start-point buffer)
                                (buffer-end-point buffer)
                                :attribute (make-attribute :foreground "#F0F0F0")))

           (delete-line (point)
             (with-point ((start point)
                          (end point))
               (line-start start)
               (line-end end)
               (delete-between-points start end)))
           (process-header (point)
             (buffer-start point)
             (loop :while (search-forward-regexp point "^#+\\s*")
                   :do (with-point ((start point))
                         (line-start start)
                         (delete-between-points start point)
                         (line-end point)
                         (put-text-property start
                                            point
                                            :attribute (make-attribute :bold t)))))
           (process-code-block (point)
             (buffer-start point)
             (loop :while (search-forward-regexp point "^```")
                   :do (with-point ((start point :right-inserting)
                                    (end point :right-inserting))
                         (let* ((mode-name (looking-at start "[\\w-]+"))
                                (syntax-table (get-syntax-table-by-mode-name mode-name)))
                           (line-start start)
                           (unless (search-forward-regexp end "^```") (return))
                           (delete-line start)
                           (delete-line end)
                           (syntax-scan-region start end :syntax-table syntax-table)
                           (apply-region-lines start
                                               end
                                               (lambda (point)
                                                 (line-start point)
                                                 (insert-string point " ")
                                                 (line-end point)
                                                 (insert-string point " ")))))))
           (process-horizontal-line (point)
             (buffer-start point)
             (let ((width (lem/popup-window::compute-buffer-width (point-buffer point))))
               (loop :while (search-forward-regexp point "^-+$")
                     :do (with-point ((start point :right-inserting)
                                      (end point :left-inserting))
                           (line-start start)
                           (line-end end)
                           (delete-between-points start end)
                           (insert-string start (make-string width :initial-element #\_))
                           (insert-character end #\newline))))))
    (let* ((buffer (make-markdown-buffer markdown-text))
           (point (buffer-point buffer)))
      (process-header point)
      (process-code-block point)
      (process-horizontal-line point)
      (trim-final-newlines point)
      buffer)))
